home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 49 / Amiga Format CD49 (2000-01-17)(Future Publishing)(GB)(Track 1 of 3)[!][issue 2000-02].iso / -serious- / programming / e / lsestuff2 / mylittlepaint.e < prev   
Text File  |  1999-11-29  |  5KB  |  131 lines
  1.  
  2. -> MyLittlePaint - Ett E-exempel.
  3. ->
  4. -> / Leif S
  5.  
  6. MODULE 'intuition/intuition', 'intuition/screens', 'graphics/text'
  7.  
  8. PROC main()
  9.      DEF wnd:PTR TO window,idcmp,wflags,msg:PTR TO intuimessage,
  10.           exit,class,lmb,rmb,cmsg:PTR TO intuimessage
  11.  
  12.      lmb:=FALSE
  13.      rmb:=FALSE
  14.  
  15.      /*             Flaggor och IDCMP för fönstret.             */
  16.      idcmp:=IDCMP_CLOSEWINDOW OR IDCMP_MOUSEMOVE OR IDCMP_VANILLAKEY
  17.      idcmp:=idcmp OR IDCMP_NEWSIZE OR IDCMP_MOUSEBUTTONS
  18.      wflags:=WFLG_CLOSEGADGET OR WFLG_DRAGBAR
  19.      wflags:=wflags OR WFLG_SIZEGADGET OR WFLG_DEPTHGADGET OR WFLG_RMBTRAP
  20.      wflags:=wflags OR WFLG_SMART_REFRESH OR WFLG_REPORTMOUSE
  21.  
  22.      wnd:=OpenW(20,50,400,300,idcmp, wflags, 'Mygraphics window',NIL,1,NIL)
  23.      IF wnd
  24.           exit:=FALSE
  25.           REPEAT  -> snurra tills någon trycker på stängknappen...
  26.                WaitPort(wnd.userport) ->vänta på meddelande från intuition.
  27.                WHILE (msg:=GetMsg(wnd.userport)) ->hämta meddelande.
  28.                     cmsg.class:=msg.class ->ta ut IDCMP.
  29.                     cmsg.code:=msg.code ->ta ut kod.
  30.                     cmsg.mousex:=msg.mousex ->ta ut x.
  31.                     cmsg.mousey:=msg.mousey -> ta ut y.
  32.                     ReplyMsg(msg) ->svara på meddelandet.
  33.                     class:=cmsg.class
  34.                     SELECT class
  35.                     CASE IDCMP_MOUSEMOVE
  36.                          title(wnd,cmsg)       -> uppdatera titelraden.
  37.                          paint(cmsg,lmb,rmb)   -> rita.
  38.                     CASE IDCMP_MOUSEBUTTONS
  39.                          lmb,rmb:=handlebut(wnd,cmsg)
  40.                     CASE IDCMP_VANILLAKEY
  41.                          handlekeys(wnd,cmsg)
  42.                     CASE IDCMP_NEWSIZE      -> ändring av storlek ?
  43.                          RefreshWindowFrame(wnd)
  44.                          title(wnd,cmsg)
  45.                     CASE IDCMP_CLOSEWINDOW  -> stängknappen ?
  46.                          exit:=TRUE
  47.                     ->DEFAULT
  48.                     ENDSELECT
  49.                ENDWHILE
  50.           UNTIL exit
  51.           CloseW(wnd)
  52.      ELSE
  53.           WriteF('Va i helv... Kunde inte öppna fönstret!\n')
  54.      ENDIF
  55. CleanUp(NIL)
  56. ENDPROC
  57.  
  58. PROC title(win:PTR TO window,mess:PTR TO intuimessage)
  59.      DEF wtitle[80]:STRING
  60.      StringF(wtitle,'  \lX : \d[6] \lY : \d[6]   \lSIZE : \d[3]x\d[3]',
  61.                     mess.mousex-win.borderleft,
  62.                     mess.mousey-win.bordertop,
  63.                     win.width-win.borderleft-win.borderright,
  64.                     win.height-win.bordertop-win.borderbottom)
  65.      SetWindowTitles(win,NIL,wtitle)  -> fixa titeln.
  66. ENDPROC
  67.  
  68. PROC paint(mess:PTR TO intuimessage,lmb,rmb)
  69.           IF (lmb<>rmb)                         -> ska vi rita/sudda ?
  70.                IF lmb                           -> rita om lmb
  71.                   Box(mess.mousex,
  72.                          mess.mousey,
  73.                          mess.mousex+10,
  74.                          mess.mousey+10,1)
  75.                ELSE                             -> sudda annars.
  76.                   Box(mess.mousex,
  77.                          mess.mousey,
  78.                          mess.mousex+10,
  79.                          mess.mousey+10,0)
  80.                ENDIF
  81.           ENDIF
  82. ENDPROC
  83.  
  84. PROC handlebut(wnd,msg:PTR TO intuimessage) -> denna rutin komer ihåg
  85. DEF code, lm, rm                            -> musknapparnas status tills
  86.      lm:=FALSE                              -> intuition säger nåt annat.
  87.      rm:=FALSE                              -> tar även hand om lite annat
  88.      code:=msg.code                         -> krafs...
  89.      SELECT code
  90.      CASE SELECTDOWN
  91.           lm:=TRUE
  92.           paint(msg,lm,rm)
  93.      CASE SELECTUP
  94.           lm:=FALSE
  95.           RefreshWindowFrame(wnd)
  96.           title(wnd,msg)
  97.      CASE MENUDOWN
  98.           rm:=TRUE
  99.           paint(msg,lm,rm)
  100.      CASE MENUUP
  101.           rm:=FALSE
  102.           RefreshWindowFrame(wnd)
  103.           title(wnd,msg)
  104.      DEFAULT
  105.      ENDSELECT
  106. ENDPROC lm, rm      -> lämna tebax musknapparnas status.
  107.  
  108. PROC floodwindow(window:PTR TO window,colour)   /* fyll föstret med nån */
  109.                                                         /* färg... */
  110.     SetAPen(window.rport,colour)
  111.     RectFill(window.rport,  window.borderleft,
  112.                             window.bordertop,
  113.                             window.width-window.borderright-1,
  114.                             window.height-window.borderbottom-1)
  115.  
  116. ENDPROC
  117.  
  118. PROC handlekeys(wnd,msg:PTR TO intuimessage)            /* hit kommer vi om */
  119.      IF (msg.code > 47) AND (msg.code < 58)  /* 0-9 */  /* nån tangent */
  120.           /* rensa fönstret med tangenterna 0-9 ! */    /* trycks ner */
  121.           floodwindow(wnd,msg.code-48)
  122.      ENDIF
  123. ENDPROC
  124.  
  125.  
  126.  
  127.  
  128.  
  129.  
  130.  
  131.